perm filename PREFIL.F4[MSS,LCS] blob sn#155881 filedate 1975-04-24 generic text, type T, neo UTF8
00010	C**** CHANGE 1, 2 AND 3 TO JFCL IN DDT WHEN USING DISTORTION.(SEE 'LINES')
00100		SUBROUTINE FILLMS(L,IDAT,R2,CENTR,R6,R7)
00110		COMMON/DPY/ST(4000),WDS(250),MEDIT,IGO/DL/RSIZ,SAVER,NAME
00120		COMMON/DST/BB,CC/FLM/X(600)
00130		COMMON/ALF/INP(65),DX,RX,D,R,C,KK,J,ML
00200		DIMENSION IDAT(1),NX(600)
00210		EQUIVALENCE (NX,X)
00220		COMMON/PLTR/IPLT,RHT,DIS/LL/LL/STF/RR(8),RSTJ2
00222	CC	INTEGER XGP
00225	CC	DATA XGP/2/,MD/6/
00226		DATA MD/6/ , RHT/1.0/
00227	C MD=DISPLAY   CHANGE XGP TO 1 IN DDT WHEN PLOTTING ON XGP!
00230		DX=DIS
00240		RX=RHT
00270		D=RSTJ2*R6
00280		R=RSTJ2*R7
00400	1	GO TO 10
00450		C=CC
00460		B=BB
00500	C  SAVES IT.  IT WILL RETURN LATER.
00525		BB=B/DIS
00550		CC=1000
00600	10	KK=-2
00700		DO 205 J=1,L
00800		CALL UNPACK(M,N,IDAT(J))
00900		KK=KK+3
00950		KX=KK+2
01000		NX(KX)=2
01100		IF(LL.EQ.3)NX(KX)=3
01200		X(KK)=ROFF((R2+D*M)*DIS)
01300		X(KK+1)=ROFF((CENTR+R*N)*RHT)
01310	2	GO TO 205
01320		X(KK+1)=X(KK+1)*(C-BB*(ABS(X(KK))))
01330	C  FOR DISTORTION
01340	205	CONTINUE
01400		NX(3)=KX
01410		DIS=1.0
01420		RHT=DIS
01500		M=MD
01600	CC	IF(IPLT)M=MP-IXRX
01610		IF(IPLT.GE.0)GO TO 20
01615	CC	M=RSIZ+.4
01617		M=1
01620		IF(RSIZ.GE.2.)M=2
01630	CC	IF(M.GT.XGP)M=XGP
01650	C  STOPS DISTORTION IN 'LINES'
01700	20	CALL FILLER(X,M)
01705	C  ******  CALLS NEW FILL.FAI (CLEM'S)
01710		DIS=DX
01720		RHT=RX
01730	3	RETURN
01740	C  NEXT TO RESET DISTORTION FACT.
01745		BB=B
01750		CC=C
01800		END
01900	
02000		SUBROUTINE ROTATE(I,L)
02100		DIMENSION I(1)
02105		COMMON/LL/LL
02110		COMMON R2,JA,CENTR,JB,RJQ(20),JQ(20)/STF/RR(8),RSTJ2
02155		EQUIVALENCE (R6,RJQ(4)),(R7,RJQ(5)),(DEG,RJQ(7))
02190		R7=R7*RSTJ2
02195		R6=R6*RSTJ2
02200		N=I(L)
02225		KNT=601
02250	C  ROTATED DATA IS PUT BACK STARTING AT LOCATION 601.
02275		I(KNT)=N
02300		DO 1 K=L+1,N+L-1
02400		CALL UNPACK(J,M,I(K))
02500		X=J*R6
02600		Y=M*R7
02700		JJ=I(K)/100000000
02800		AX=ATAN2(X,Y)*57.29578
02900		HYP=SQRT(X**2+Y**2)
03000		ROT=DEG+AX
03100		J=ROFF(HYP*COSD(ROT))
03200		M=ROFF(HYP*SIND(ROT))
03300		KNT=KNT+1
03400		IF(J)J=1000-J
03500		IF(M)M=1000-M
03600	1	I(KNT)=M*10000+J+JJ*100000000
03700		L=601
03800		R6=1.
03900		R7=1.
04000		RSTJ2=1.
04100	C  SIZE CHANGES MUST BE MADE BEFORE ROTATION!!!!! ELSE IT DISTORTS.
04200		END